home *** CD-ROM | disk | FTP | other *** search
/ PD ROM 1 / PD ROM Volume I - Macintosh Software from BMUG (1988).iso / Programming / FORTH Folder / Conblk Folder / CONBLK.FX2 < prev    next >
Encoding:
Text File  |  1984-09-26  |  9.0 KB  |  1 lines  |  [BLKS/M4TH]
  1. Converts CONBLK.4TH version 1.00 to version 1.01  ( 080884 JWB) John W. Baxter 71735,1626                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                       1000 MINIMUM.OBJECT  1000 MINIMUM.VOCAB                         PAGE CR CR ." CONBLK.FX2...Change CONBLK.4TH 1.00 to 1.01" CR   2 6 THRU                                                        FIX  ( Does not return )                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                        ( Constants, etc: files package )                               VARIABLE IFILE#   -1  IFILE# ! : IFILE ( -- file# )  IFILE# @ ; 3 CONSTANT GENEVA  4 CONSTANT MONACO  0 CONSTANT NIL            CREATE ="BLKS      "BLKS ,                                      18 FIELD +FCB.NAME     22 FIELD +FCB.VREFNUM                    00 FIELD +GOOD                                                  : @GOOD     ( reply -- flag | extract good flag ) +GOOD W@ ;    06 FIELD +VREFNUM                                               : @VREFNUM  ( reply -- vol# | get volume ref number )              +VREFNUM <W@ ;                                               10 FIELD +FNAME                                                 CREATE IREPLY 80 ALLOT    IREPLY +FNAME CONSTANT INAME                                                                                                                                                                                                                                                                          ( PREPARE.GET GET.FCB RELEASE.FCB MOVEREFNUM )                                                                                  : PREPARE.GET    ( $prompt -- | Prepare blank screen with                                       the prompt string at top )          PAGE GENEVA TEXTFONT BOLD TEXTSTYLE                             30 GET.LINE.HEIGHT MOVE.TO  COUNT TYPE                          MONACO TEXTFONT PLAIN TEXTSTYLE  ;                                                                                          : GET.FCB  ( addr -- | Get a file number, store at addr )           NEXT.FCB SWAP ! ;                                                                                                           : RELEASE.FCB  ( file# -- | Release the FCB )                       >FCB +FCB.NAME NIL SWAP ! ;                                                                                                 : MOVEREFNUM  ( file#\reply -- | Copy vol ref reply --> fcb )       @VREFNUM  SWAP >FCB +FCB.VREFNUM W! ;                       ( GET.INPUT.NAME BLOCK.OPEN )                                                                                                   : GET.INPUT.NAME ( typelist\numtypes\reply\$prompt -- | Prompt                     for input file name)                               PREPARE.GET  >R >R >R  80   90 XY>POINT                         NIL  R>  R>  R@                                                 (GET.FILE) PAGE R> @GOOD 0= IF BYE THEN  ;                                                                                : BLOCK.OPEN  ( --- | Open Convert 1.00)                            IFILE# GET.FCB                                                  ="BLKS 1 IREPLY  " Change what Blocks file from CONBLK 1.00 to 1.01?"                                                           GET.INPUT.NAME  INAME IFILE ASSIGN IFILE IREPLY MOVEREFNUM      IFILE OPEN   ?FILE.ERROR                                        IFILE SELECT ;                                                                                                              ( VERIFY )                                                                                                                      : VERIFY ( -- flag | Verify that current block file is                               version 1.00 of Convert )                  " Version 1.00 last update 29 July 84 at 1330"                    COUNT 1 BLOCK 8 C/L * + 13 + -TEXT 0= ;                                                                                       CREATE NEWBLOCK1 B/BUF ALLOT  CREATE NEWBLOCK16 B/BUF ALLOT                                                                     : CAPTURE ( -- | Copy the new blocks from this file)                7 BLOCK NEWBLOCK1  B/BUF CMOVE                                  8 BLOCK NEWBLOCK16 B/BUF CMOVE ;                                                                                            : CHANGE  ( -- | Change blocks 1 and 16)                            NEWBLOCK1   1 BLOCK B/BUF CMOVE UPDATE                          NEWBLOCK16 16 BLOCK B/BUF CMOVE UPDATE FLUSH ;              ( FIX )                                                                                                                         : FIX ( -- | Change one or more CONBLK.4TH Blocks files)            1 ACTIVATE.EVENT SCALE  -1 XOR  EVENTS !                        CAPTURE  BLOCK-FILE @ CLOSE ?FILE.ERROR      BEGIN              BLOCK.OPEN VERIFY                        IF                     CHANGE                                 ELSE                     PAGE IFILE @FILE.NAME COUNT TYPE                                ."  isn't version 1.00 of CONBLK.4TH!"                          CR CR ." Press space to continue"                               KEY DROP                               THEN                     IFILE CLOSE ?FILE.ERROR  IFILE RELEASE.FCB   AGAIN ;                                                                                                                                                                                                                                                                        ( Text File Conversion)                           ( 080884 JWB)   0 ' OPEN 16+ C!  ( FIX#1.101)                                   FORTH  DEFINITIONS  OPTIONS.MENU  DECIMAL 3500 MINIMUM.OBJECT   FIND FILE.CONVERSION IFTRUE FORGET FILE.CONVERSION IFEND        TRACE @                                   IFTRUE              1100 MINIMUM.VOCAB  : FILE.CONVERSION ;  OTHERWISE              1100 VOCABULARY FILE.CONVERSION                                   FILE.CONVERSION DEFINITIONS                IFEND              : VERSION$ " Version 1.01 last update 8 August 84 at 1900" ;                                                                    2 30 THRU   CR CR                                               ." File Conversion Loaded.  Use Convert menu" CR                VERSION$ COUNT TYPE CR CR                                                                                                       ." Copyright (C) 1984, John W. Baxter" CR                       FORTH DEFINITIONS   TRACE OFF  ABORT                            ( SET.LINE )                                      ( 080884 JWB)                                                                 : SET.LINE ( n\addr --- | Line n at addr to TEXT.BUF )              SWAP SET.LINE.HEADER                                            64 -TRAILING  TEXT.BUF+  TEXT.BUF+CR ;                      TRACE @ TRACE OFF                                               : SET.HEX.BYTE ( c --- | Hex representation of c to TEXT.BUF )      HEX <# # # #> TEXT.BUF+ DECIMAL ;  TRACE !                                                                                  : SET.HEX.LINE  ( n\addr --- | prepare line w/unprintable )         OVER SET.HEX.HEADER  64 -TRAILING  DUP 32 >       IF            32 0                                   DO                       OVER C@ SET.HEX.BYTE 1- SWAP 1+ SWAP LOOP                       TEXT.BUF+CR TEXT.BUF.WRITE   ROT SET.CON.HEADER ELSE            ROT DROP                                        THEN            0 DO DUP C@ SET.HEX.BYTE 1+ LOOP DROP TEXT.BUF+CR ;